home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0189.ZIP / LOAN3.INC < prev    next >
Text File  |  1986-02-08  |  10KB  |  313 lines
  1.  
  2. procedure Print_Amortization;
  3.   const PRINT_PAGE = 58;   { Number of print lines per page. }
  4.         VIDEO_PAGE = 20;   { Number of print lines on video screen. }
  5.         TOF        = #12;  { Printer top of form control code. }
  6.         ADDR_SIZE  = 4;    { Number of bytes required to store an Address }
  7.                            { CP/M-80 systems replace 4 with 2. }
  8.  
  9.   type  Address = array[1..2] of Integer;
  10.         Totals  = (Payments,Principle,Interest);
  11.  
  12.   var   hold_out_ptr    : Address;
  13.         total_ptr       : Totals;
  14.         month_offset,
  15.         offset_factor,
  16.         calc_pmt,
  17.         periodic_rate,
  18.         loan_balance    : Real;
  19.         final_total     : array[Payments..Interest] of Real;
  20.         year_total      : array[Payments..Interest] of Real;
  21.         line_cnt        : Integer;
  22.         pmt_no,
  23.         max_line        : Byte;
  24.  
  25.   function Ready_To_Print: Boolean;
  26.     begin
  27.       if (loan.out_dev = PRINTER) then
  28.         begin
  29.           Clear_Prompts;
  30.           Display_Prompt(CMD_LINE,'CMD', QUIT_KEY + ' Cancel Printing ');
  31.           Display_Prompt(MSG_LINE,'INP','Press ' + ENTER_KEY +
  32.                                   'when PRINTER is READY. ==> ');
  33.           Ready_To_Print := (Valid_Key([CR,QUIT]) = CR);
  34.           Display_Prompt(MSG_LINE,'MSG','Printing amortization table...');
  35.         end
  36.       else
  37.         Ready_To_Print := TRUE;
  38.     end; { Ready_To_Print }
  39.  
  40.   procedure Init_Variables;
  41.     var i : Byte;
  42.  
  43.     begin
  44.       month_offset := 0.0;
  45.       offset_factor := 12 / loan.pmts_per_yr;
  46.       calc_pmt := loan.payment;
  47.       periodic_rate := loan.rate / loan.pmts_per_yr / 100.0;
  48.       loan_balance := loan.principle;
  49.       for total_ptr := Payments to Interest do
  50.         begin
  51.           year_total[total_ptr] := 0.0;
  52.           final_total[total_ptr] := 0.0;
  53.         end;
  54.       pmt_no := ZERO;
  55.     end; { Init_Variables }
  56.  
  57.   procedure Init_Output_Device;
  58.     begin
  59.       Move (ConOutPtr,hold_out_ptr,ADDR_SIZE); { Save console device addr. }
  60.       if loan.out_dev = PRINTER then
  61.         begin
  62.           Move (LstOutPtr,ConOutPtr,ADDR_SIZE);
  63.           max_line := PRINT_PAGE;
  64.         end
  65.       else
  66.         max_line := VIDEO_PAGE;
  67.     end; { Init_Output_Device }
  68.  
  69.   procedure Print_Table;
  70.     type  Month_Str    = string[3];
  71.  
  72.     const month_id     : array[1..12] of Month_Str =
  73.                            ('Jan','Feb','Mar','Apr',
  74.                             'May','Jun','Jul','Aug',
  75.                             'Sep','Oct','Nov','Dec');
  76.  
  77.     var  interest_amt,
  78.          principle_amt : Real;
  79.          current_year  : Integer;
  80.          current_month : Byte;
  81.          user_quit     : Boolean;
  82.  
  83.  
  84.     procedure New_Page(device: Char);
  85.  
  86.       procedure Print_Header;
  87.         begin
  88. {$I-}
  89.           WriteLn(' Payment       Remaining    Total of     Principle   Interest');
  90.           io_status := IOresult;
  91. {$I+}
  92.           if (io_status = ZERO) then
  93.             WriteLn(' No./Date      Principle    Payments     Payment     Payment')
  94.           else
  95.             Disp_IO_Error('Printer');
  96.           if (not err_flag) then
  97.             begin
  98.               Repeat_Char('-',62); WriteLn;
  99.               line_cnt := 3;
  100.             end;
  101.         end { Print_Header };
  102.  
  103.       begin { New_Page }
  104.         if (device = VIDEO) then
  105.           ClrScr
  106.         else
  107.           if (pmt_no > ZERO) then
  108.             Write(TOF);
  109.         if (not user_quit) then
  110.           Print_Header;
  111.       end; { New_Page }
  112.  
  113.     procedure Continue_Prompt;
  114.       begin
  115.         Display_Prompt(CMD_LINE,'CMD', QUIT_KEY + ' Cancel Printing ');
  116.         Display_Prompt(PROMPT_LINE,'INP',
  117.                        'Press ANY KEY to continue. ==> ');
  118.         Read(Kbd,inchr);
  119.         GoToXY(1,PROMPT_LINE); ClrEol;
  120.         if (inchr = QUIT) then
  121.           user_quit := TRUE;
  122.       end; { Continue_Prompt }
  123.  
  124.     function Calc_Month: Integer;
  125.       begin
  126.         Calc_Month := Round(loan.first_mo +
  127.                       month_offset - 1.49) mod 12 + 1;
  128.       end; { Calc_Month }
  129.  
  130.     function Calc_Year: Integer;
  131.       begin
  132.           Calc_year := loan.first_yr +
  133.                        ((Round(month_offset) + loan.first_mo - 1) div 12);
  134.       end; { Calc_Year }
  135.  
  136.     procedure Calc_Detail_Line;
  137.       var cents      : Real;
  138.  
  139.       begin
  140.         current_month := Calc_Month;
  141.         current_year := Calc_Year;
  142.         interest_amt := (loan_balance * periodic_rate);
  143.         cents := Frac(interest_amt);
  144.         interest_amt := interest_amt - cents +
  145.                         (Round(cents * 100.0) * 0.01);
  146.         if ((loan_balance + interest_amt) < calc_pmt) then
  147.           calc_pmt := (loan_balance + interest_amt);
  148.         principle_amt := calc_pmt - interest_amt;
  149.         loan_balance := loan_balance - principle_amt;
  150.         final_total[Payments] := final_total[Payments] + calc_pmt;
  151.         final_total[Principle] := final_total[Principle] + principle_amt;
  152.         final_total[Interest] := final_total[Interest] + interest_amt;
  153.         if (loan.select_yr = ZERO) or (loan.select_yr = current_year) then
  154.           begin
  155.             year_total[Payments]   := year_total[Payments] + calc_pmt;
  156.             year_total[Principle] := year_total[Principle] + principle_amt;
  157.             year_total[Interest]  := year_total[Interest] + interest_amt;
  158.           end;
  159.       end; { Calc_Detail_Line }
  160.  
  161.     procedure Print_Detail_Line;
  162.       begin
  163.         with loan do
  164.         if (select_yr = 0) or (select_yr = current_year) then
  165.           begin
  166. {$I-}
  167.             WriteLn((pmt_no + 1):3,month_id[current_month]:5,
  168.                     current_year:5,loan_balance:11:2,final_total[Payments]:12:2,
  169.                     principle_amt:12:2,interest_amt:12:2);
  170.             io_status := IOresult;
  171.             line_cnt := Succ(line_cnt);
  172.           end;
  173. {$I+}
  174.         if (io_status <> ZERO) then
  175.           Disp_IO_Error('Printer')
  176.       end; { Print_Detail_Line }
  177.  
  178.     procedure Check_EndOfPage;
  179.       begin
  180.         if line_cnt > max_line then
  181.           begin
  182.             if (loan.out_dev = VIDEO) then
  183.               Continue_Prompt;
  184.             New_Page(loan.out_dev);
  185.           end;
  186.       end; { Check_EndOfPage }
  187.  
  188.     procedure Check_EndOfYear;
  189.       var  next_year,
  190.            next_month,
  191.            current_month : Integer;
  192.  
  193.       function End_Loan_Year: Boolean;
  194.         begin
  195.           End_Loan_Year :=
  196.             ((Round(month_offset) mod 12) = ZERO) and
  197.             (next_month <> current_month);
  198.         end; { End_Loan_Year }
  199.  
  200.       function End_Select_Year: Boolean;
  201.         begin
  202.           with loan do
  203.             if (select_yr > ZERO) and (next_year = (select_yr + 1)) then
  204.               begin
  205.                 End_Select_Year := TRUE;
  206.                 pmt_no := Trunc(no_of_pmts + 0.99);
  207.               end
  208.             else
  209.               End_Select_Year := False;
  210.         end; { End_Select_Year }
  211.  
  212.       function End_Loan: Boolean;
  213.         begin
  214.           End_Loan :=
  215.             ((pmt_no + 1) = Trunc(loan.no_of_pmts + 0.99));
  216.         end; { End_Pmts }
  217.  
  218.       procedure Print_Annual_Totals;
  219.         begin
  220.           if (loan.out_dev = PRINTER) then
  221.             WriteLn;
  222.           Write('Total for Yr.',SPACE:11);
  223.           for total_ptr := Payments to Interest do
  224.             begin
  225.               Write(year_total[total_ptr]:12:2);
  226.               year_total[total_ptr] := 0.0;
  227.             end;
  228.           WriteLn; line_cnt := Succ(line_cnt);
  229.           if (loan.out_dev = PRINTER) then
  230.             begin
  231.               WriteLn; line_cnt := line_cnt + 2;
  232.             end;
  233.         end; { Print_Annual_Totals }
  234.  
  235.       begin { Check_EndOfYear }
  236.         current_month := Calc_Month;
  237.         month_offset := month_offset + offset_factor;
  238.         next_month := Calc_Month;
  239.         next_year := Calc_Year;
  240.         if (loan.pmts_per_yr > 1) then
  241.           if (End_Loan_Year or End_Select_Year) or End_Loan then
  242.             Print_Annual_Totals;
  243.       end; { Check_EndOfYear }
  244.  
  245.     procedure Check_UsrQuit;
  246.       begin
  247.         if KeyPressed then
  248.           begin
  249.             Read(Kbd,inchr);
  250.             if (inchr = QUIT) then
  251.               user_quit := TRUE;
  252.           end;
  253.       end; { Check_Usr_Quit }
  254.  
  255.     function End_Table: Boolean;
  256.       begin
  257.         if (user_quit or (pmt_no >= Trunc(loan.no_of_pmts + 0.99))) then
  258.           begin
  259.             End_Table := TRUE;
  260.             if (loan.out_dev = VIDEO) and (line_cnt > (max_line - 3)) then
  261.               begin
  262.                 Continue_Prompt;
  263.                 New_Page(VIDEO);
  264.               end;
  265.           end
  266.         else
  267.           End_Table := FALSE;
  268.       end; { End_Table }
  269.  
  270.     procedure Print_Final_Totals;
  271.       begin
  272.         if (loan.select_yr = ZERO) then
  273.           begin
  274.             WriteLn;
  275.             WriteLn('Loan Totals ',SPACE:12,final_total[Payments]:12:2,
  276.                     final_total[Principle]:12:2,final_total[Interest]:12:2);
  277.           end;
  278.         if (loan.out_dev = PRINTER) then
  279.           Write(TOF)
  280.         else
  281.           Continue_Prompt;
  282.       end; { Print_Final_Totals }
  283.  
  284.     begin { Print_Table }
  285.       user_quit := FALSE;
  286.       err_flag := FALSE;
  287.       New_Page(loan.out_dev);
  288.       repeat
  289.         Calc_Detail_Line;
  290.         Print_Detail_Line;
  291.         if (not err_flag) then
  292.           begin
  293.             Check_EndOfPage;
  294.             Check_EndOfYear;
  295.             Check_UsrQuit;
  296.             pmt_no := Succ(pmt_no);
  297.           end;
  298.       until (End_Table or err_flag);
  299.       if (not (err_flag or user_quit)) then
  300.         Print_Final_Totals;
  301.       Move(hold_out_ptr,ConOutPtr,ADDR_SIZE); { Restore console device addr. }
  302.     end; { Print_Table }
  303.  
  304.   begin { Print_Amortization }
  305.     if Ready_To_Print then
  306.       begin
  307.         Init_Variables;
  308.         Init_Output_Device;
  309.         Print_Table;
  310.       end;
  311.   end; { Print_Amortization }
  312.  
  313.